home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CD ROM Paradise Collection 4
/
CD ROM Paradise Collection 4 1995 Nov.iso
/
os2
/
adaptor.zip
/
ADAPT.ZIP
/
adaptor
/
examples
/
purdue
/
prob07.fcm
< prev
next >
Wrap
Text File
|
1993-06-26
|
3KB
|
143 lines
PROGRAM PROB07
C
C PROBLEM 07
C
C REFERENCE: PROBLEMS TO TEST PARALLEL AND VECTOR LANGUAGES
C CSD-TR 516, COMPUTER SCIENCE, PURDUE UNIVERSITY
C JOHN R. RICE, MAY 1, 1985
C
C REVISED BY JOHN R. RICE AND J. JING, OCT. 1, 1990
C
C
C *************************************************
C * Adapted for FORTRAN D benchmarking *
C * by T. HAUPT (haupt@sccs.npac.syr.edu) *
C * *
C * Northeast Parallel Architectures Center *
C * at Syracuse University, Syracuse, NY, USA *
C *************************************************
C
C
C VERSION SEQUENTIAL-1.00 (PLAIN FORTRAN77)
C ==================================================
INTEGER KASES,NK,MK
PARAMETER (KASES=3)
INTEGER N(KASES),M(KASES)
cmf$ layout N(:SERIAL), M(:SERIAL)
DATA N /3,5,10/
DATA M /2048,16384,32768/
REAL P(4)
cmf$ layout P(:serial)
DO 50 K = 1, KASES
NK=N(K)
DO 40 I = 1, KASES
call cm_timer_clear (0)
call cm_timer_start (0)
DO MANY=1,50
MK=M(I)
CALL DOIT(NK,MK,P)
ENDDO
call cm_timer_stop (0)
PRINT *,'PROBLEM 7 WITH N,M =',NK,MK
WRITE (6,*) 'GIVES P(',P(1),') =',P(2)
WRITE (6,*) 'AND P(',P(3),') =',P(4)
call cm_timer_print (0)
40 CONTINUE
50 CONTINUE
c STOP
END
SUBROUTINE DOIT(NK,MK,P)
INTEGER NK,MK
REAL P(4)
cmf$ layout P(:SERIAL)
REAL DX
INTEGER I,J,K
DIMENSION XI(NK),XL(NK), F(NK)
cmf$ layout XI(:SERIAL), XL(:SERIAL), F(:SERIAL)
DIMENSION TEMP(NK),TAMP(NK),TUMP(NK)
cmf$ layout TEMP(:SERIAL), TAMP(:SERIAL), TUMP(:SERIAL)
DIMENSION X(MK)
REAL DENOM(NK)
cmf$ layout DENOM(:SERIAL)
REAL TP(MK)
DO I = 1, NK
XI(I)=FLOAT(I-1)
ENDDO
call FUN(XI,NK,F)
DX=XI(NK)/MK
!HPF$ INDEPENDENT, LOCAL_ACCESS
DO K = 1, MK
X(K)=0.5+(K-1)*DX
ENDDO
C
C DENOMINATOR
C
DO I = 1, NK
TEMP(I) = 1.
DENOM(I) = 1.0
DO J = 1, NK
IF (J.NE.I) THEN
TEMP(J) = XI(I)-XI(J)
DENOM(I) = DENOM(I)*TEMP(J)
ENDIF
ENDDO
C
C NOTE: THE DENOMINATOR IS INVERTED HERE SO THAT A MULTIPLICATION
C CAN BE DONE LATER
C
DENOM(I) = 1.0/DENOM(I)
ENDDO
!HPF$ INDEPENDENT, LOCAL_ACCESS
DO K = 1, MK
TP(K) = 0.0
DO I = 1, NK
DO J = 1, NK
IF (J.NE.I) THEN
TAMP(J) = X(K)-XI(J)
ENDIF
ENDDO
TAMP(I) = 1.0
PTAMP = 1.0
DO J = 1, NK
PTAMP = PTAMP*TAMP(J)
ENDDO
XL(I) = PTAMP*DENOM(I)
ENDDO
DO I = 1, NK
TUMP(I) = F(I)*XL(I)
TP(K) = TP(K)+TUMP(I)
ENDDO
ENDDO
P(1)=X(1)
P(3)=X(MK)
P(2) = TP(1)
P(4) = TP(MK)
c RETURN
END
SUBROUTINE FUN(X,NK,F)
INTEGER NK
REAL, ARRAY(NK) :: X,F
cmf$ layout X(:SERIAL)
cmf$ layout F(:SERIAL)
F = X**2-3.0*X-4.0
c F=EXP(X)
c RETURN
END